Programmer Power Tools/Programmer Power Tools.iso/surfmodl/surfm203.arc/SURFSRC.ARC/SURFBGI.PAS

Pascal/Delphi Source File | 1988-01-31 | 15.2 KB | 549 lines

{$I defines.inc}
{*********************************************************}
{                                                         }
{       Extensions to the                                 }
{       Turbo Pascal Version 4.0                          }
{       GRAPH Unit Interface                              }
{                                                         }
{*********************************************************}

{ Version 1.00a,  Date 30 Jan 1988, Author: Kevin Lowey                    }

{ This unit should be included AFTER the GRAPHICS unit in your program.  It}
{ it implements the BGI routines for unsupported devices.  The difference  }
{ is these routines are always resident, instead of in a file on the disk  }
{ so they eat up memory.                                                   }

{ In addition to this file, you will also have to change DEFINES.INC.      }
{ You must create a DEFINE statement which describes your device, so people}
{ can turn off or on the device when they compile surfmodl.                }

{ To use this system, include the routines for your graphics device into   }
{ the case statement in each  procedure, with an IFDEF and ENDIF around it }
{ so people can turn off the device.  The important routines are the ones  }
{ to select the driver (initgraph and detectgraph), the ones to leave graph}
{ mode (restorecrtmode and closegraph), and the one to draw a point on the }
{ screen (putpixel).  Other routines such as putimage and getimage can be  }
{ replaced by dummy routines that do nothing.  This will get rid of some   }
{ functions, but the basic SURFMODL program will still work.               }
{                                                                          }
{ See the Turbo Pascal manual (or the online help) for a description of    }
{ each procedure.                                                          }

{ You will also have to change the definitions in the SURFGRAF unit.  This }
{ unit contains all the SURFMODL graphics primitives.  You will have to    }
{ change MAXSYS, and add your device to the list of supported devices.     }
{ See the VAXMATE example below and in SURFBGI for more details            }

{ I give an example using the DEC VAXMATE computer.  This computer provides}
{ the standard CGA graphics modes, plus a 640x400x2 graphics mode which is }
{ almost compatible with the AT&T 640x400x2 graphics mode.  The only       }
{ difference is the interrupt $10 function used to enter graphics mode.    }
{ The memory map, etc. is the same.  I cheated in implementing the graphics}
{ by having the program use the AT&T .BGI driver, and give the VAXMATE     }
{ interrupt immediately after using INITGRAPH or SETGRAPHMODE.  The program}
{ thinks it is using an AT&T, so all the graphics funtions are available.  }
{ You may wish to use a similar trick with your driver.                    }
{                                                                          }
{ NOTE, the vaxmate driver works as is, but should not have to be used.    }
{ the surfmodl disk includes a TSR program called EMULATT which makes a    }
{ vaxmate think it is an AT&T computer.  Once EMULATT is loaded, you can   }
{ choose the AT&T option from the menu and the graphics routines will work }
{ on the vaxmate.  I left the routines in here just for demonstration use  }

{ You will also have to modify the SURFGRAF unit to include your device in }
{ the menu of options available.                                           }

Unit SURFBGI;  { Surfmodl BGI emulation and true BGI routines }

interface
uses DOS, GRAPH;

{$IFDEF USE8087}
TYPE REAL = single;
{$ENDIF}

const
  {Redo Turbo Pascal constants}
  NOTput  = 4;
  NormalPut = 0;

  GRok = 0;

  DETECT = 0;
  CGA = 1;
  MCGA = 2;
  EGA = 3;
  EGA64 = 4;
  EGAMONO = 5;
  RESERVED = 6;
  HERCMONO = 7;
  ATT400 = 8;
  VGA = 9;
  PC3270 = 10;

  { add your own constant here for your machine, such as SANYO = 11  }

{$IFDEF VAXMATE} {should never need to define, see notes above}
  VM400 = 11;  {Vaxmate constant}
  { Also add constants for all the modes available, starting at 0.   }
  { See the Graph Unit description in the Turbo Pascal manual or in  }
  { the online help for examples }

  { Vaxmate CGA compatible modes }
  VM400C0   = CGAC0; { 320x200 palette 0: LightGreen, LightRed, Yellow; 1 page }
  VM400C1   = CGAC1; { 320x200 palette 1: LightCyan, LightMagenta, White; 1 page }
  VM400C2   = CGAC2; { 320x200 palette 2: Green, Red, Brown; 1 page }
  VM400C3   = CGAC3; { 320x200 palette 3: Cyan, Magenta, LightGray; 1 page }
  VM400Med  = 4;  { 640x200 1 page }

  { Vaxmate high resolution modes }
  VM400HiCo = 5;  { 640x400 4 color 1 page }
  VM400Hi   = 6;  { 640x400 1 color 1 page }
{$ENDIF}



{  detection, initialization and crt mode routines }
{  see the Turbo Pascal manual for details on what the routines must do }

procedure DetectGraph(var GraphDriver, GraphMode : integer);
procedure InitGraph(var GraphDriver : integer;
                    var GraphMode   : integer;
                        PathToDriver : String);
procedure GetModeRange(GraphDriver : integer; var LoMode, HiMode : integer);
procedure SetGraphMode(Mode : integer);
procedure settextjustify (Horiz, Vert : word);
function getmaxcolor:word;
procedure RestoreCrtMode;
procedure closegraph;
procedure outtextxy (x,y :integer; textline:string);
function  GetMaxX : integer;
function  GetMaxY : integer;
procedure PutPixel(X, Y : integer; Pixel : word);
function graphresult : integer;
procedure GetImage(x1, y1, x2, y2 : integer;
                   var BitMap);
procedure PutImage(X, Y : integer; var
          BitMap; BitBlt : word);
function ImageSize(x1, y1, x2, y2 : integer) : word;
function GraphErrorMsg(ErrorCode : integer) : string;
Procedure Setcolor(color:word);



IMPLEMENTATION

const
  { used in detect graph }
  CASSETTE_IO     = $15;
  DEC_CONF_WORD   = $D0;


  {Used in setting video mode}
  VIDEO_SERVICES  = $10;
  DEC_HIRES       = $D0;
  DEC_HIRES_COLOR = $D1;
  SET_VIDEO_MODE  = $00;
  write_pixel     = $0C;

  {Dummy used in CASE statements to achieve device independance}
  dummy = maxint;

var
  regs : registers;
  grdriver : integer;
  GetGraphMode : integer;
  GraphError : integer;
  grmaxx  : integer;
  grmaxy  : integer;


function GraphErrorMsg(ErrorCode : integer) : string;
begin
  GraphErrorMsg := graph.grapherrormsg(errorcode);
end;


Procedure Setcolor(color:word);
begin
  graph.setcolor(color);
end;


procedure outtextxy (x,y :integer; textline:string);
begin
  case grdriver of
    dummy : ;
{$IFDEF VAXMATE}
    vm400 : if getgraphmode <> VM400HICO then
               graph.outtextxy (x,y,textline);
{$ENDIF}
    else
     graph.outtextxy (x,y,textline);
  end; {case}
end;



function getmaxcolor:word;
begin
  case grdriver of
    dummy : ;
{$IFDEF VAXMATE}
    VM400 : begin
              if (getgraphmode in [VM400c0..VM400MED,VM400HI]) then
                getmaxcolor := graph.getmaxcolor
              else if getgraphmode = VM400HICO then
                getmaxcolor := 3;
            end; {Vaxmate }
{$ENDIF}
    else begin
      getmaxcolor := graph.getmaxcolor;
    end;
  end; {case}
end; { getmaxcolor}



procedure PutPixel(X, Y : integer; pixel : word);
begin
  case GRdriver of
    dummy : ;
{$ifdef VAXMATE}
    VM400 : begin  { Use DOS bios calls to write a pixel }
              with regs do begin
                ah := write_pixel;
                al := pixel;
                cx := x;
                dx := y;
              end; {with}
              intr (video_services,regs);
            end;
{$ENDIF}
    else begin {BGI}
      graph.putpixel (x,y,pixel);
    end; {else}
  end; {case}
end; {putpixel}




procedure DOS_SET_MODE (MODE:BYTE);
begin
  {DEC specific modes}
  with regs do begin
    ah := Set_Video_Mode;
    al := mode;
  end;
   intr (Video_services,regs);
end; {Dos_Set_Mode}



procedure restorecrtmode;
begin
  case grdriver of
    Dummy : ;
    else begin
       graph.restorecrtmode;
    end;
  end;
end; {restorecrtmode}



procedure closegraph;
begin
  case grdriver of
    dummy : ;
    else begin
      graph.closegraph;
      GraphError := graph.graphresult;
      grdriver := 0;
    end; {else}
  end; {case}
end; {closegraph}


function  GetMaxX : integer;
begin
  case grdriver of
    dummy : ;

{$IFDEF VAXMATE}
    VM400 : begin
              if getgraphmode in [vm400c0 .. VM400C3] then
                getmaxx := 319
              else
                getmaxx := 639;
            end;
{$ENDIF}

    else begin
      getmaxx := graph.getmaxx;
    end;
  end; {case}
end; {getMaxX}



function  GetMaxY : integer;
begin
  case grdriver of
    dummy :;

{$IFDEF VAXMATE}
    VM400 : begin
              if getgraphmode in [vm400c0 .. VM400MED] then
                getmaxy := 199
              else
                getmaxy := 399;
            end;
{$ENDIF}

    else begin
      getmaxy := graph.getmaxy;
    end;
  end; {case}
end; {getMaxy}


function graphresult : integer;
{ my definition of graphresult so my routines can return proper values }
begin
  if (GraphError < -15) or (GraphError > 0) then
    GraphError := 0;

  graphresult := GraphError;
  GraphError := 0;
end;



{ *** detection, initialization and crt mode routines *** }

procedure DetectGraph(var GraphDriver, GraphMode : integer);

{ this procedure must detect what machine you are on.  Some machines  }
{ include routines for this, while others you may have to look at the }
{ copyright message for the bios.                                     }

begin
  graphdriver :=  0;
  graphmode   :=  0;

  graph.detectgraph(graphdriver,graphmode);

{$IFDEF VAXMATE}  {This doesn't work right.  Some non-vaxmates are reported}
  if graphdriver = RESERVED then begin
    {check if vaxmate}
    regs.ah := DEC_CONF_WORD;
    intr(CASSETTE_IO,regs);

    if (regs.AH = $86) then begin  {Vaxmate Detected}
      if (regs.BX and $00E0) = $0040 then begin {vaxmate graphics system}
        graphdriver := VM400;
        GraphMode   := VM400HI;
      end
    end { If machine vaxmate }
  end; {if RESERVED perhaps vaxmate}
{$ENDIF}

  grdriver := graphdriver;
  getGraphMode := graphmode;
  GraphError := graph.graphresult;
end; {Detectgraph}


procedure SetGraphMode(Mode : integer);
{Routine to enter graphics mode}

begin

  case grdriver of
    dummy :;

{$IFDEF VAXMATE}
{Uses the AT&T graph mode so Turbo's .BGI routines work correct,      }
{ then calls its own interrupt to go into graphics mode on the VAXmate}
    VM400 : begin
              if mode in [VM400C0..VM400MED] then begin
                graph.setgraphmode (mode);
                GraphError := graph.graphresult;
              end {CGA compatible modes}
              ELSE if mode = VM400HI then begin
                  graph.setgraphmode (ATT400HI);
                  GraphError := graph.graphresult;
                  dos_set_mode (DEC_Hires)
              end
              else if mode = VM400HICO then begin
                  graph.setgraphmode (att400hi);
                  grapherror := graph.graphresult;
                  dos_set_mode (DEC_HIRES_COLOR)
              end
              else
                GraphError := grInvalidMode;
            end; {Vaxmate mode}
{$ENDIF}

    else Begin {Not DEC compatible mode}
      graph.setgraphmode (mode);
      GraphError := graph.graphresult;
    end;

  end; {case}
end; {setgraphmode}



procedure InitGraph(var GraphDriver : integer;
                    var GraphMode   : integer;
                        PathToDriver : String);
var
  temp1,temp2 : integer;

begin
  if graphdriver = 0 then
    detectgraph (graphdriver,graphmode);

  grdriver := GraphDriver;
  getGraphMODE := GraphMode;

  case graphdriver of
    dummy :;
    { usually nothing is needed here because the "drivers" are already }
    { "loaded" into memory for our own devices. }
{$IFDEF VAXMATE}
    VM400: begin
             temp1 := ATT400;
             if graphmode > VM400MED then
               temp2 := ATT400HI
             else
               temp2 := graphmode;
             graph.initgraph (temp1,temp2,pathtodriver);
             GraphError := graph.graphresult;
             if GraphError > grok then
               setgraphmode (getgraphmode);
           end;
{$ENDIF}
    else begin {not extended BGI }
      graph.initgraph (graphdriver, graphmode, pathtodriver);
      GraphError := graph.graphresult;
      grdriver := graphmode;
    end; {else}
  end; { Case }

end;



procedure GetModeRange(GraphDriver : integer; var LoMode, HiMode : integer);
begin
  case graphdriver of
    dummy : ;

{$IFDEF VAXMATE}
    VM400 : begin
              lomode := VM400C0;
              HiMode := VM400HI;
            end;
{$ENDIF}

    ELSE begin { Not an extended mode }
      graph.getmoderange(graphdriver,lomode,himode);
      GraphError := graph.graphresult;
    end; {Not an extended mode}
  end; {Case}
end; {GetModeRange}



procedure settextjustify (Horiz, Vert : word);
begin
  case grdriver of
    dummy : ;
    {The vaxmate version has not been implemented for 640x400x4 mode, but  }
    {the 640x400x2 mode works properlly when emulating an AT&T computer    }
    else begin {normal BGI routines}
      graph.settextjustify (horiz, vert);
      GraphError := graph.graphresult;
    end;
  end; {case}
end; {settextjustify}



procedure GetImage(x1, y1, x2, y2 : integer;
                   var BitMap);
BEGIN
  Case grdriver of

    dummy : ; {dummy position}

{$IFDEF VAXMATE}
    { AT&T getimage works for all modes but 640x400x4}
    VM400 : begin {Digital Vaxmate}
              if getgraphmode <> VM400HICO then
                graph.getimage(x1,y1,x2,y2,bitmap)
              else
                GraphError := grerror;
            end;
{$ENDIF}
    else  graph.getimage (x1,y1,x2,y2,bitmap); {Normal BGI driver}
  end; {Case}
end; {getimage}



procedure PutImage(X, Y : integer; var
          BitMap; BitBlt : word);
begin
  Case grdriver of
    dummy : ; {dummy position}

{$IFDEF VAXMATE}
    { AT&T driver works for all modes but 640x400x4}
    VM400 : begin {Digital Vaxmate}
              if getgraphmode <> VM400HICO then
                graph.putimage (x,y,bitmap,bitblt)
              else
                grapherror := grerror;
            end;
{$ENDIF}

    else  graph.putimage (x,y,bitmap,bitblt); {Normal BGI driver}
  end; {Case}
end; {Imagesize}



function ImageSize(x1, y1, x2, y2 : integer) : word;
begin
  Case grdriver of

    dummy : ; {dummy position}

{$IFDEF VAXMATE}
    {AT&T driver works for all modes but 640x400x4}
    VM400 : begin {Digital Vaxmate}
              if getgraphmode <> VM400HICO then
                imagesize := graph.ImageSize (x1,y1,x2,y2)
              else
                imagesize := 0;
            end; { Digital Vaxmate }
{$ENDIF}

    else begin  { Normal BGI driver }
      imagesize := graph.ImageSize (x1,y1,x2,y2); {Normal BGI driver}
    end;
  end; {Case}
end; {imagesize}


begin
  GraphError := 0;
  grdriver := 0;
  getgraphmode := 0;
end.